home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / WIN_PRO / DS-1.ZIP;1 / RUNTIME.ZIP / RLOCAL.R < prev    next >
Encoding:
Text File  |  1992-02-10  |  39.1 KB  |  1,669 lines
  1. /*
  2.  * File: rlocal.r
  3.  * Routines needed for different systems.
  4.  */
  5.  
  6. /*
  7.  * The following code is operating-system dependent [@rlocal.01].
  8.  *  Routines needed by different systems.
  9.  */
  10.  
  11. #if PORT
  12.    /* place for anything system-specific */
  13. Deliberate Syntax Error
  14. #endif                    /* PORT */
  15.  
  16. #if AMIGA
  17. #if LATTICE
  18. long _STACK = 20000;
  19. long _MNEED = 200000;    /* reserve space for allocation (may be too large) */
  20. #endif                    /* LATTICE */
  21. #if AZTEC_C
  22. /*
  23.  * abs
  24.  */
  25. abs(i)
  26. int i;
  27. {
  28.     return ((i<0)? (-i) : i);
  29. }
  30.  
  31. /*
  32.  * ldexp
  33.  */
  34. double ldexp(value,exp)
  35. double value;
  36. {
  37.   double retval = 1.0;
  38.   if(exp>0) {
  39.     while(exp-->0) retval *= 2.0;
  40.   } else if (exp<0) {
  41.     while(exp++<0) retval = retval / 2.0;
  42.   }
  43.   return value * retval;
  44. }
  45.  
  46. /*
  47.  *  abort()
  48.  */
  49. novalue abort()
  50. {
  51.   fprintf(stderr,"icon error with ICONCORE set\n");
  52.   fflush(stderr);
  53.   exit(1);
  54. }
  55.  
  56. #ifdef SystemFnc
  57.  
  58. /*
  59.  * Aztec C version 3.6 does not support system(), but here is a substitute.
  60.  */
  61. #include <ctype.h>
  62.  
  63. #define KLUDGE1 256
  64. #define KLUDGE2 64
  65. int system(s)
  66. char *s;
  67. {
  68.    char text[KLUDGE1], *cp=text;
  69.    char *av[KLUDGE2];
  70.    int ac = 0;
  71.    int l  = strlen(s);
  72.  
  73.    if (l >= KLUDGE1)
  74.       return -1;
  75.    strcpy(text,s);
  76.    av[ac++] = text;
  77.    while(*cp && ac<KLUDGE2-1) {
  78.       if (isspace(*cp)) {
  79.          *cp++ = '\0';
  80.      while(isspace(*cp))
  81.         cp++;
  82.          if (*cp)
  83.         av[ac++] = cp;
  84.          }
  85.       else {
  86.          cp++;
  87.          }
  88.       }
  89.     av[ac] = NULL;
  90.     return fexecv(av[0], av);
  91. }
  92. #endif                    /* SystemFnc */
  93. #endif                    /* AZTEC_C */
  94. #endif                    /* AMIGA */
  95.  
  96. #if ARM
  97.  
  98. #include <ctype.h>
  99. #include <stdio.h>
  100. #include <stdlib.h>
  101. #include <string.h>
  102. #include "kernel.h"
  103.  
  104. char *mktemp (const char *);
  105.  
  106. static char *strdup (const char *);
  107. static int os_cmd (char *);
  108. static int cmp_cmd (char *, char *);
  109.  
  110. #define MAX_PIPE 20
  111.  
  112. typedef enum
  113. {
  114.    unopened = 0,
  115.    reading,
  116.    writing
  117. }
  118. pipemode;
  119.  
  120. static struct pipe
  121. {
  122.    char *command;   /* The command being executed      */
  123.    char *name;   /* The name of the pipe file      */
  124.    FILE *fd;   /* The file used as a pipe      */
  125.    pipemode pmode;   /* The open mode of the pipe      */
  126.    int retval;   /* The return value of the command   */
  127. }
  128. pipes[MAX_PIPE];
  129.  
  130. FILE *popen (char *command, char *mode)
  131. {
  132.    FILE *current;
  133.    char *name;
  134.    int i;
  135.    pipemode curmode;
  136.    int rval = -1;
  137.    char tmp[11];
  138.  
  139.    /* decide on mode */
  140.    if ( mode[1] != 0 )
  141.       return NULL;
  142.    else if ( *mode == 'r' )
  143.       curmode = reading;
  144.    else if ( *mode == 'w' )
  145.       curmode = writing;
  146.    else
  147.       return NULL;
  148.  
  149.    /* Get a slot in the pipes structure */
  150.    for ( i = 0; i < MAX_PIPE; ++i )
  151.    {
  152.       if ( pipes[i].pmode == unopened )
  153.          break;
  154.    }
  155.  
  156.    if ( i >= MAX_PIPE )
  157.       return NULL;
  158.  
  159.    /* Get a file name to use */
  160.    sprintf(tmp, "Pipe%.2d", i);
  161.    name = mktemp(tmp);
  162.  
  163.    if ( name == NULL )
  164.       return NULL;
  165.  
  166.    /*
  167.     * If we're reading, just call system() to get a file filled
  168.     * with output.
  169.     */
  170.  
  171.    if ( curmode == reading )
  172.    {
  173.       char *tmpname;
  174.       int oscmd = os_cmd(command);
  175.       char cmd[256];
  176.       int n;
  177.  
  178.       if (*command == '%')
  179.       {
  180.          oscmd = 1;
  181.          ++command;
  182.       }
  183.  
  184.       if (!oscmd)
  185.       {
  186.          char *s;
  187.  
  188.          while (*command && isspace(*command))
  189.             ++command;
  190.  
  191.          s = command;
  192.  
  193.          while (*s && !isspace(*s))
  194.             ++s;
  195.          
  196.          n = sprintf(cmd, "%.*s > %s%s",
  197.             s - command, command, name, s);
  198.       }
  199.       else
  200.       {
  201.          tmpname = mktemp("PipeTmp");
  202.  
  203.          if (tmpname == NULL)
  204.          {
  205.             free(name);
  206.             return NULL;
  207.          }
  208.  
  209.          n = sprintf(cmd, "%s{ > %s }", command, tmpname);
  210.       }
  211.  
  212.       /* Emergency! Overflow in command buffer! */
  213.       if (n > 255)
  214.       {
  215.          if (oscmd)
  216.          {
  217.             remove(tmpname);
  218.             free(tmpname);
  219.          }
  220.          free(name);
  221.          return NULL;
  222.       }
  223.  
  224.       _kernel_setenv("Sys$ReturnCode", "0");
  225.       rval = system(cmd);
  226.  
  227.       if (rval == _kernel_ERROR)
  228.       {
  229.          remove(tmpname);
  230.          free(tmpname);
  231.          free(name);
  232.          return NULL;
  233.       }
  234.  
  235.       if (oscmd)
  236.       {
  237.          int ch;
  238.          FILE *in = fopen(tmpname, "r");
  239.          FILE *out = fopen(name, "w");
  240.  
  241.          if (in == NULL || out == NULL)
  242.          {
  243.             remove(tmpname);
  244.             free(tmpname);
  245.             free(name);
  246.             return NULL;
  247.          }
  248.  
  249.          /* Strip out CRs from the output */
  250.          while ((ch = getc(in)) != EOF && !ferror(out))
  251.          {
  252.             if (ch != '\r')
  253.                putc(ch, out);
  254.          }
  255.  
  256.          /* Did we succeed? */
  257.          ch = (ferror(in) || ferror(out));
  258.  
  259.          /* Tidy up */
  260.          fclose(in);
  261.          fclose(out);
  262.          remove(tmpname);
  263.          free(tmpname);
  264.  
  265.          if (ch)
  266.          {
  267.             free(name);
  268.             return NULL;
  269.          }
  270.       }
  271.  
  272.       if ( (current = fopen(name,"r")) == NULL )
  273.       {
  274.          free(name);
  275.          return NULL;
  276.       }
  277.    }
  278.    else
  279.    {
  280.       if ( (current = fopen(name,"w")) == NULL )
  281.       {
  282.          free(name);
  283.          return NULL;
  284.       }
  285.    }
  286.  
  287.    pipes[i].command = strdup(command);
  288.    pipes[i].name = name;
  289.    pipes[i].fd = current;
  290.    pipes[i].pmode = curmode;
  291.    pipes[i].retval = rval;
  292.    return current;
  293. }
  294.  
  295. #define ReadCat    5
  296.  
  297. /* Create a temporary file name by adding a directory prefix to file.
  298.  * If the external variable temp_dir is not zero, this directory will be
  299.  * used. Otherwise, the following are used, in order.
  300.  *   1. <Tmp$Dir>
  301.  *   2. &.Tmp
  302.  *   3. The current directory.
  303.  * The function returns zero on an error (temp_dir is not a directory, or
  304.  * malloc() failed), otherwise it returns a malloc-ed string containing
  305.  * the required name.
  306.  */
  307.  
  308. static char *concat (const char *dir, const char *file);
  309.  
  310. char *temp_dir = 0;
  311.  
  312. char *mktemp (const char *file)
  313. {
  314.    char *dir;
  315.    char *name;
  316.    char buf[11];
  317.    int len = strlen(file);
  318.    _kernel_osfile_block blk;
  319.    _kernel_swi_regs regs;
  320.  
  321.    /* Is the supplied filename a pure file name? */
  322.    if (len > 10)
  323.       return 0;
  324.  
  325.    /* Pad out the supplied filename on the left with a unique ID
  326.     * (Based on the program start time)
  327.     */
  328.    if (len < 10 && _kernel_swi(OS_GetEnv,®s,®s) == NULL)
  329.    {
  330.       int i;
  331.       char *time = (char *)regs.r[2];
  332.  
  333.       strcpy(buf,file);
  334.  
  335.       for (i = len; i < 10; ++i)
  336.       {
  337.          char c = time[(9 - i) >> 1];
  338.  
  339.          if (i & 1)
  340.             c >>= 4;
  341.  
  342.          c &= 0x0F;
  343.          buf[i] = "abcdefghijklmnop"[c];
  344.       }
  345.  
  346.       buf[10] = 0;
  347.  
  348.       file = buf;
  349.    }
  350.  
  351.    /* First, try the supplied directory */
  352.    if ( temp_dir )
  353.    {
  354.       if ( _kernel_osfile(ReadCat,temp_dir,&blk) == 2 )
  355.          return concat(temp_dir,file);
  356.       else
  357.       {
  358.          /* Is it a filing system name only? */
  359.          len = strlen(temp_dir);
  360.  
  361.          if (temp_dir[len-1] != ':')
  362.             return 0;
  363.  
  364.          /* One extra, just in case file == "", for the '@' */
  365.          name = malloc(len + strlen(file) + 2);
  366.  
  367.          if (name == 0)
  368.             return 0;
  369.  
  370.          strcpy(name,temp_dir);
  371.          name[len] = '@';
  372.          name[len+1] = '\0';
  373.  
  374.          if (_kernel_osfile(ReadCat,name,&blk) != 2)
  375.          {
  376.             free(name);
  377.             return 0;
  378.          }
  379.  
  380.          strcpy(&name[len],file);
  381.          return name;
  382.       }
  383.    }
  384.  
  385.    /* Otherwise, go through the list... */
  386.  
  387.    /* First of all, try <Tmp$Dir> */
  388.    if ((dir = getenv("Tmp$Dir")) != 0)
  389.    {
  390.       if (_kernel_osfile(ReadCat,dir,&blk) == 2)
  391.          return concat(dir,file);
  392.       else
  393.       {
  394.          /* Is it a filing system name only? */
  395.          len = strlen(dir);
  396.  
  397.          if (dir[len-1] != ':')
  398.             goto no_go;
  399.  
  400.          /* One extra, just in case file == "", for the '@' */
  401.          name = malloc(len + strlen(file) + 2);
  402.  
  403.          if (name == 0)
  404.             goto no_go;
  405.  
  406.          strcpy(name,dir);
  407.          name[len] = '@';
  408.          name[len+1] = '\0';
  409.  
  410.          if (_kernel_osfile(ReadCat,name,&blk) != 2)
  411.          {
  412.             free(name);
  413.             goto no_go;
  414.          }
  415.  
  416.          strcpy(&name[len],file);
  417.          return name;
  418.       }
  419.    }
  420.  
  421. no_go:
  422.    /* No <Tmp$Dir>, so try &.Tmp, if it exists */
  423.    if (_kernel_osfile(ReadCat,"&.Tmp",&blk) == 2)
  424.       return concat("&.Tmp",file);
  425.  
  426.    /* Out of luck - use the current directory */
  427.    name = malloc(strlen(file)+1);
  428.    if ( name )
  429.       strcpy(name,file);
  430.  
  431.    return name;
  432. }
  433.  
  434. static char *concat (const char *dir, const char *file)
  435. {
  436.     char *result = malloc(strlen(dir)+strlen(file)+2);
  437.     char *p = result;
  438.  
  439.     if ( result == 0 )
  440.         return 0;
  441.  
  442.     while ( *dir )
  443.         *p++ = *dir++;
  444.  
  445.     *p++ = '.';
  446.     while ( *file )
  447.         *p++ = *file++;
  448.  
  449.     *p = '\0';
  450.  
  451.     return result;
  452. }
  453.  
  454. /* ----------------------------------------------------------------- */
  455.  
  456. #ifdef test
  457.  
  458. #include <stdio.h>
  459.  
  460. int main (int argc, char *argv[])
  461. {
  462.     char *tmp;
  463.  
  464.     if ( argc != 2 && argc != 3 )
  465.     {
  466.         fprintf(stderr,"Usage: %s file [dir]\n",argv[0]);
  467.         return 1;
  468.     }
  469.  
  470.     if ( argc == 3 )
  471.         temp_dir = argv[2];
  472.  
  473.     tmp = mktemp (argv[1]);
  474.  
  475.     printf("Temp file = %s\n", tmp ? tmp : "<Not possible>");
  476.  
  477.     return 0;
  478. }
  479.  
  480. #endif
  481.  
  482. int pclose (FILE *current)
  483. {
  484.     int rval;
  485.     int i;
  486.  
  487.     /* Get the appropriate slot in thbe pipes structure */
  488.     for ( i = 0; i < MAX_PIPE; ++i )
  489.     {
  490.         if ( pipes[i].fd == current )
  491.             break;
  492.     }
  493.  
  494.     if ( i >= MAX_PIPE )
  495.         return -1;
  496.  
  497.     if ( pipes[i].pmode == reading )
  498.     {
  499.         /* Input pipes are just files we're done with */
  500.         rval = pipes[i].retval;
  501.         fclose(current);
  502.         remove(pipes[i].name);
  503.     }
  504.     else
  505.     {
  506.         /*
  507.          * Output pipes are temporary files we have
  508.          * to cram down the throats of programs.
  509.          */
  510.         char *command = pipes[i].command;
  511.         int oscmd = os_cmd(command);
  512.         int n;
  513.         char cmd[256];
  514.  
  515.         if (*command == '%')
  516.         {
  517.             oscmd = 1;
  518.             ++command;
  519.         }
  520.  
  521.         /* Close the pipe file */
  522.         fclose(current);
  523.  
  524.         /* Create the required command string */
  525.         if (oscmd)
  526.             n = sprintf(cmd, "%s{ < %s }", command, pipes[i].name);
  527.         else
  528.         {
  529.             char *s;
  530.  
  531.             while (*command && isspace(*command))
  532.                 ++command;
  533.  
  534.             s = command;
  535.  
  536.             while (*s && !isspace(*s))
  537.                 ++s;
  538.             
  539.             n = sprintf(cmd, "%.*s < %s%s",
  540.                 s - command, command, pipes[i].name, s);
  541.         }
  542.  
  543.         /* Check for overflow in command buffer */
  544.         if (n > 255)
  545.             rval = -1;
  546.         else
  547.         {
  548.             _kernel_setenv("Sys$ReturnCode", "0");
  549.             rval = system(cmd);
  550.         }
  551.  
  552.         remove(pipes[i].name);
  553.     }
  554.  
  555.     /* clean up current pipe */
  556.     pipes[i].pmode = unopened;
  557.     free(pipes[i].name);
  558.     free(pipes[i].command);
  559.     return rval;
  560. }
  561.  
  562. /* save a string on the heap; return pointer to it */
  563.  
  564. static char *strdup (const char *str)
  565. {
  566.     char *p = malloc(strlen(str)+1);
  567.  
  568.     if (p == NULL)
  569.     {
  570.         fprintf(stderr,"Not enough memory to save string\n");
  571.         exit(1);
  572.     }
  573.  
  574.     return (strcpy(p,str));
  575. }
  576.  
  577. /* Check whether a command is an OS command (binary search on the table
  578.  * os_commands of valid OS commands).
  579.  */
  580.  
  581. static char *os_commands[] =
  582. {
  583.     "access",    "adfs",        "alphabet",    "alphabets",
  584.     "append",    "audio",    "basic",    "breakclr",
  585.     "breaklist",    "breakset",    "build",    "cat",
  586.     "cdir",        "channelvoice",    "close",    "configure",
  587.     "continue",    "copy",        "count",    "countries",
  588.     "country",    "create",    "debug",    "delete",
  589.     "deskfs",    "dir",        "dump",        "echo",
  590.     "enumdir",    "error",    "eval",        "ex",
  591.     "exec",        "fileinfo",    "fontcat",    "fontlist",
  592.     "fx",        "go",        "gos",        "help",
  593.     "iconsprites",    "if",        "ignore",    "info",
  594.     "initstore",    "key",        "keyboard",    "lcat",
  595.     "lex",        "lib",        "list",        "load",
  596.     "memory",    "memorya",    "memoryi",    "modules",
  597.     "obey",        "opt",        "poduleload",    "podules",
  598.     "podulesave",    "pointer",    "print",    "qsound",
  599.     "quit",        "ram",        "remove",    "rename",
  600.     "rmclear",    "rmensure",    "rmfaster",    "rmkill",
  601.     "rmload",    "rmreinit",    "rmrun",    "rmtidy",
  602.     "rommodules",    "run",        "save",        "schoose",
  603.     "scopy",    "screenload",    "screensave",    "sdelete",
  604.     "set",        "seteval",    "setmacro",    "settype",
  605.     "sflipx",    "sflipy",    "sget",        "shadow",
  606.     "shellcli",    "show",        "showregs",    "shut",
  607.     "shutdown",    "sinfo",    "slist",    "sload",
  608.     "smerge",    "snew",        "sound",    "speaker",
  609.     "spool",    "spoolon",    "srename",    "ssave",
  610.     "stamp",    "status",    "stereo",    "tempo",
  611.     "time",        "tuning",    "tv",        "type",
  612.     "unplug",    "unset",    "up",        "voices",
  613.     "volume",    "wimppalette",    "wimpslot",    "wimptask",
  614.     "wipe"
  615. };
  616.  
  617. #define NUM_CMDS (sizeof(os_commands) / sizeof(char *))
  618.  
  619. static int os_cmd (char *cmd)
  620. {
  621.     int low = 0;
  622.     int high = NUM_CMDS - 1;
  623.  
  624.     while (low <= high)
  625.     {
  626.         int mid = (high + low) / 2;
  627.         int i = cmp_cmd(cmd,os_commands[mid]);
  628.  
  629.         if (i == 0)
  630.             return 1;
  631.         else if (i < 0)
  632.             high = mid - 1;
  633.         else
  634.             low = mid + 1;
  635.     }
  636.  
  637.     return 0;
  638. }
  639.  
  640. static int cmp_cmd (char *cmd, char *name)
  641. {
  642.     while (*name && tolower(*cmd) == *name)
  643.         ++name, ++cmd;
  644.  
  645.     if (*name)
  646.         return (tolower(*cmd) - *name);
  647.  
  648.     return (*cmd != '\0' && !isspace(*cmd));
  649. }
  650.  
  651. #ifdef test
  652. int main (int argc, char *argv[])
  653. {
  654.     FILE *fp;
  655.     char *cmd;
  656.  
  657.     if (argc <= 1)
  658.     {
  659.         printf("Usage Popen [cmd or Popen ]cmd\n");
  660.         return 0;
  661.     }
  662.  
  663.     cmd = argv[1];
  664.  
  665.     if (*cmd++ == ']')
  666.     {
  667.         fp = popen(cmd,"w");
  668.         fprintf(fp,"hello\nworld\nhow\nare\nyou\n");
  669.         pclose(fp);
  670.     }
  671.     else
  672.     {
  673.         char buf[500];
  674.         fp = popen(cmd,"r");
  675.         while (!feof(fp))
  676.         {
  677.             if (!fgets(buf,499,fp))
  678.             {
  679.                 printf("Read error!\n");
  680.                 return 1;
  681.             }
  682.             buf[strlen(buf)-1] = 0;
  683.             printf(">%s<\n", buf);
  684.         }
  685.         pclose(fp);
  686.     }
  687.  
  688.     return 0;
  689. }
  690. #endif
  691.  
  692. int unlink (const char *name)
  693. {
  694.     _kernel_osfile_block blk;
  695.  
  696.     return (_kernel_osfile(6,name,&blk) <= 0);
  697. }
  698.  
  699. int getch (void)
  700. {
  701.     return _kernel_osrdch();
  702. }
  703.  
  704. int getche (void)
  705. {
  706.     int ch = _kernel_osrdch();
  707.  
  708.     _kernel_oswrch(ch);
  709.  
  710.     return ch;
  711. }
  712.  
  713. int kbhit (void)
  714. {
  715.     return ((_kernel_osbyte(152,0,0) & 0x00FF0000) != 0x00010000);
  716. }
  717.  
  718. char *ecvt(double number, int ndigit, int *decpt, int *sign)
  719. {
  720.     int n = 0;
  721.     static char buf[30];
  722.  
  723.     /* Sort out the sign */
  724.     if (number >= 0)
  725.         *sign = 0;
  726.     else
  727.     {
  728.         *sign = 1;
  729.         number = -number;
  730.     }
  731.  
  732.     /* Normalise the number to 0.1 <= number < 1, setting decpt */
  733.     if (number >= 1)
  734.     {
  735.         while (number >= 1)
  736.         {
  737.             ++n;
  738.             number /= 10.0;
  739.         }
  740.     }
  741.     else if (number != 0.0 && number < 0.1)
  742.     {
  743.         while (number < 0.1)
  744.         {
  745.             --n;
  746.             number *= 10.0;
  747.         }
  748.     }
  749.     *decpt = n;
  750.  
  751.     sprintf(buf, "%#.*f", ndigit, number);
  752.  
  753.     /* Skip the leading "0." */
  754.     return (buf+2);
  755. }
  756. #endif                    /* ARM */
  757.  
  758. #if ATARI_ST
  759. #if LATTICE
  760.  
  761. long _STACK = 10240;
  762. long _MNEED = 200000;    /* reserve space for allocation (may be too large) */
  763.  
  764. #include <osbind.h>
  765.  
  766. /*  Structure necessary for handling system time. */
  767.    struct tm {
  768.        short tm_year;
  769.        short tm_mon;
  770.        short tm_wday;
  771.        short tm_mday;
  772.        short tm_hour;
  773.        short tm_min;
  774.        short tm_sec;
  775.    };
  776.  
  777. struct tm *localtime(clock)   /* fill structure with clock time */
  778. int clock;     /* millisecond timer value, if supplied; not used */
  779. {
  780.   static struct tm tv;
  781.   unsigned int time, date;
  782.  
  783.   time = Tgettime();
  784.   date = Tgetdate();
  785.   tv.tm_year = ((date >> 9) & 0x7f) + 80;
  786.   tv.tm_mon  = ((date >> 5) & 0xf) - 1;
  787.   tv.tm_mday = date & 0x1f;
  788.   tv.tm_hour = (time >> 11) & 0x1f;
  789.   tv.tm_min  = (time >> 5)  & 0x3f;
  790.   tv.tm_sec  = 2 * (time & 0x1f);
  791.  
  792.   tv.tm_wday = weekday(tv.tm_mday,tv.tm_mon+1,tv.tm_year);
  793.   return(&tv);
  794. }
  795.  
  796.  
  797. weekday(day,month,year)   /* find day of week from    */
  798. short day, month, year;   /* day, month, and year     */
  799. {                         /* Sunday..Saturday is 0..6 */
  800.   int index, yrndx, mondx;
  801.  
  802.   if(month <= 2) {   /* Jan or Feb month adjust */
  803.       month += 12;
  804.       year  -=  1;
  805.   }
  806.  
  807.   yrndx = year + (year / 4) - (year / 100) + (year / 400);
  808.   mondx = 2 * month + (3 * (month + 1)) / 5;
  809.   index = day + mondx + yrndx + 2;
  810.   return(index % 7);
  811. }
  812.  
  813.  
  814.  
  815. time(ptime)   /* return value of millisecond timer */
  816. int  *ptime;
  817. {
  818.   int  tmp, ssp;   /* value of supervisor stack pointer */
  819.   static int  *tmr = (int *) 0x04ba;   /* addr of timer */
  820.  
  821.   ssp = gemdos(0x20,0);   /* enter supervisor mode */
  822.   tmp = *tmr * 5;         /* get millisecond timer */
  823.   ssp = gemdos(0x20,ssp); /* enter programmer mode */
  824.  
  825.   if(ptime != NULL)
  826.       *ptime = tmp;
  827.  
  828.   return(tmp);
  829. }
  830.  
  831. int brk(p)
  832. char *p;
  833. {
  834.   char *sbrk();
  835.   long int l, m;
  836.  
  837.   l = (long int)p;
  838.   m = (long int)sbrk(0);
  839.  
  840.   return((lsbrk((long) (l - m)) == 0) ? -1 : 0);
  841. }
  842.  
  843. #endif                    /* LATTICE */
  844. #endif                    /* ATARI_ST */
  845.  
  846. #if MACINTOSH
  847. #if MPW
  848. /*
  849. **  Special routines for Macintosh Programmer's Workshop
  850. **  implementation of the Icon Programming Language
  851. */
  852.  
  853. #include <Types.h>
  854. #include <Events.h>
  855. #include <OSUtils.h>
  856. #define MaxBlockX MaxBlock /* MaxBlock Icon definition conflicts */
  857. #undef MaxBlock           /* with Mac Toolbox routine */
  858. #include <Memory.h>
  859. #define MaxBlock MaxBlockX
  860. #undef MaxBlockX
  861. #include <Errors.h>
  862.  
  863. /*
  864. **  Initialization and Termination Routines
  865. */
  866. /*
  867. **  MacExit -- This function is installed by an onexit() call in MacInit
  868. **  -- it is called automatically when the program terminates.
  869. */
  870. void
  871. MacExit()
  872. {
  873.   void ResetStack();
  874.   extern Ptr MemBlock;
  875.  
  876.   ResetStack();
  877.   if (MemBlock != NULL) DisposPtr(MemBlock);
  878. }
  879.  
  880. /*
  881. **  MacInit -- This function is called near the beginning of execution of
  882. **  iconx.  It is called by our own brk/sbrk initialization routine.
  883. */
  884. void
  885. MacInit()
  886. {
  887.   atexit(MacExit);
  888. }
  889.  
  890.  
  891. /*
  892. **  Brk and Sbrk Equivalents
  893. */
  894.  
  895. typedef Ptr caddr_t;
  896.  
  897. static caddr_t MemBlock, Break, Limit;
  898. word xcodesize;
  899.  
  900. init_brk()
  901. {
  902.   static short init = 0;
  903.   Size max, grow, size;
  904.   char *v;
  905.  
  906.   if (!init) {
  907.     init = 1;
  908.     MacInit();
  909.     if ((v = getenv("ICONSIZE")) != NULL) {    /* if ICONSIZE defined */
  910.       if ((size = atol(v)) <= 0) {        /* if ICONSIZE negative */
  911.     max = MaxMem(&grow);
  912.     size = max + grow - (size < 0 ? -size : max / 4);
  913.       }
  914.     }
  915.     else {                    /* if ICONSIZE undefined */
  916.       size = xcodesize + mstksize + statsize + ssize + abrsize + 512;
  917.     }
  918.     if ((MemBlock = NewPtr(size)) == NULL) {
  919.       syserr("problem allocating Mac memory");
  920.     }
  921.     Break = MemBlock;
  922.     Limit = MemBlock + size;
  923.   }
  924.   return 1;
  925. }
  926.  
  927. caddr_t
  928. brk(addr)
  929. caddr_t addr;
  930. {
  931.   Size newsize;
  932.  
  933.   if (!init_brk()) return (caddr_t)-1;
  934.   if (addr < MemBlock) return (caddr_t)-1;
  935.   if (addr < Limit) Break = addr;
  936.   else {
  937.     newsize = addr - MemBlock;
  938.     SetPtrSize(MemBlock, newsize);
  939.     if (MemError() != noErr) return (caddr_t)-1;
  940.     Break = Limit = addr;
  941.   }
  942.   return (caddr_t)0;
  943. }
  944.  
  945. caddr_t
  946. sbrk(incr)
  947. int incr;
  948. {
  949.   caddr_t start;
  950.  
  951.   if (!init_brk()) return (caddr_t)-1;
  952.   start = Break;
  953.   if (incr != 0) {
  954.     if (brk(start + incr) == (caddr_t)-1) return (caddr_t)-1;
  955.   }
  956.   return start;
  957. }
  958.  
  959. #endif                    /* MPW */
  960. #endif                    /* MACINTOSH */
  961.  
  962. #if MSDOS
  963. int pathFind(target, buf, n)
  964.    char target[];
  965.    char buf[];
  966.    int n;
  967.    {
  968.    char *path;
  969.    register int i;
  970.    int res;
  971.    struct stat sbuf;
  972.  
  973.    if ((path = getenv("PATH")) == 0)
  974.       path = "";
  975.  
  976.    if (!getcwd(buf, n)) {        /* get current working directory */
  977.       *buf = 0;        /* may be better to do something nicer if we can't */
  978.       return 0;        /* find out where we are -- struggling to achieve */
  979.       }            /* something can be better than not trying */
  980.  
  981.    /* attempt to find the icode file in the current directory first */
  982.    /* this mimicks the behavior of COMMAND.COM */
  983.    if ((i = strlen(buf)) > 0) {
  984.       i = buf[i - 1];
  985.       if (i != '\\' && i != '/' && i != ':')
  986.          strcat(buf, "/");
  987.       }
  988.    strcat(buf, target);
  989.    res = stat(buf, &sbuf);
  990.  
  991.    while(res && *path) {
  992.       for (i = 0; *path && *path != ';'; ++i)
  993.          buf[i] = *path++;
  994.       if (*path)            /* skip the ; or : separator */
  995.          ++path;
  996.       if (i == 0)            /* skip empty fragments in PATH */
  997.          continue;
  998.       if (i > 0 && buf[i - 1] != '/' && buf[i - 1] != '\\' &&
  999.          buf[i - 1] != ':')
  1000.             buf[i++] = '/';
  1001.       strcpy(buf + i, target);
  1002.       res = stat(buf, &sbuf);
  1003.       /* exclude directories (and any other nasties) from selection */
  1004.       if (res == 0 && sbuf.st_mode & S_IFDIR)
  1005.          res = -1;
  1006.       }
  1007.  
  1008.    if (res != 0)
  1009.       *buf = 0;
  1010.    return res == 0;
  1011.    }
  1012.  
  1013. FILE *pathOpen(fname, mode)
  1014.    char *fname;
  1015.    char *mode;
  1016.    {
  1017.    char buf[150 + 1];
  1018.    int i, use = 1;
  1019.  
  1020.    for( i = 0; buf[i] = fname[i]; ++i)
  1021.       /* find out if a path has been given in the file name */
  1022.       if (buf[i] == '/' || buf[i] == ':' || buf[i] == '\\')
  1023.          use = 0;
  1024.  
  1025.    /* If a path has been given with the file name, don't bother to
  1026.       use the PATH */
  1027.  
  1028.    if (use && !pathFind(fname, buf, 150))
  1029.        return 0;
  1030.  
  1031.    return fopen(buf, mode);
  1032.    }
  1033. #if INTEL_386
  1034. /*  sbrk(incr) - adjust the break value by incr.
  1035.  *  Returns the new break value, or -1 if unsuccessful.
  1036.  */
  1037.  
  1038. pointer sbrk(incr)
  1039. msize incr;
  1040. {
  1041.    static pointer base = 0;        /* base of the sbrk region */
  1042.    static pointer endofmem, curr;
  1043.    pointer result;
  1044.    union REGS rin, rout;
  1045.  
  1046.    if (!base) {                    /* if need to initialize                */
  1047.       rin.w.eax = 0x80004800;    /* use DOS allocate function with max    */
  1048.       rin.w.ebx = 0xffffffff;    /*  request to determine size of free    */
  1049.       intdos(&rin, &rout);        /*  memory (including virtual memory.    */
  1050.       rin.w.ebx = rout.w.ebx;    /* DOS allocate all of memory.            */
  1051.       intdos(&rin, &rout);
  1052.       if (rout.w.cflag)
  1053.          return (pointer)-1;
  1054.       curr = base = (pointer)rout.w.eax;
  1055.       endofmem = (pointer)((char *)base + rin.w.ebx);
  1056.       }
  1057.     
  1058.    if ((char *)curr + incr > (char *)endofmem)
  1059.       return (pointer)-1;
  1060.    result = curr;
  1061.    curr = (pointer)((char *)curr + incr);
  1062.    return result;
  1063.  
  1064. }
  1065.  
  1066. /*  brk(addr) - set the break address to the given value, rounded up to a page.
  1067.  *  returns 0 if successful, -1 if not.
  1068.  */
  1069.  
  1070. int brk(addr)
  1071. pointer addr;
  1072. {
  1073.    int result;
  1074.    result = sbrk((char *)addr - (char *)sbrk(0)) == (pointer)-1 ? -1 : 0;
  1075.    return result;
  1076. }
  1077.  
  1078. #endif                    /* INTEL_386 */
  1079.  
  1080. #if TURBO
  1081. extern unsigned _stklen = 16 * 1024;
  1082. #endif                    /* TURBO */
  1083.  
  1084. #if LATTICE
  1085.  
  1086. #include <error.h>
  1087.  
  1088. int _stack = (8 * 1024);
  1089. long int _mneed = (20 * 1024);
  1090.  
  1091. extern long int *sp;
  1092. long int **xsp = &sp;  /* Used for rswitch.asm .. since 'sp' is a reserved */
  1093.                /* symbol for the assembler.. */
  1094.  
  1095. extern char *statend;  /* Indicator for when to use malloc for _GETBF */
  1096.  
  1097. int brk(p)
  1098. char *p;
  1099. {
  1100.    char *sbrk();
  1101.    long int l, m;
  1102.  
  1103.    l = (long int)p;
  1104.    m = (long int)sbrk((word)0);
  1105.  
  1106.    if( lsbrk((long) (l - m) ) == 0) return -1;
  1107.    else return 0;
  1108. }
  1109.  
  1110. novalue abort()    /* Abort set to 'dump' icon data area.. */
  1111. {
  1112. #ifdef DeBugIconx
  1113.    blkdump();
  1114. #endif                    /* DeBugIconx */
  1115.    fflush(stderr);
  1116.    fcloseall();
  1117.    _exit(1);
  1118. }
  1119. #endif                    /* LATTICE */
  1120. #endif                    /* MSDOS */
  1121.  
  1122. #if MVS || VM
  1123. #if SASC
  1124. #include <options.h>
  1125. char _linkage = _OPTIMIZE;
  1126.  
  1127. #if MVS
  1128. char *_style = "tso:";          /* use dsnames as file names */
  1129. #define SYS_OSVS
  1130. #else                    /* MVS */
  1131. #define SYS_CMS
  1132. #endif                    /* MVS */
  1133. int _mneed = 512000;            /* size of sbrk-managed region */
  1134.  
  1135. #define RES_SIGNAL
  1136. #define RES_COPROC
  1137. #define RES_IOUTIL
  1138. #define RES_DSNAME
  1139. #define RES_FILEDEF
  1140. #define RES_UNITREC
  1141.  
  1142. #include <resident.h>
  1143.  
  1144. #endif                    /* SASC */
  1145. #endif                    /* MVS || VM */
  1146.  
  1147. #if OS2
  1148. novalue abort()
  1149. {
  1150. #ifdef DeBugIconx
  1151.     blkdump();
  1152. #endif
  1153.     fflush(stderr);
  1154.     fcloseall();
  1155.     _exit(1);
  1156. }
  1157. /* Pipe support for OS/2 */
  1158. #include <fcntl.h>
  1159. #include <stddef.h>
  1160. #include <process.h>
  1161. #include <errno.h>
  1162.  
  1163. #define INCL_DOS
  1164. #include <os2.h>
  1165.  
  1166. static int _pipes[_NFILE];
  1167.  
  1168. /*
  1169.  * popen("command",mode)
  1170.  *
  1171.  * cmd = command to be passed to shell. (CMD.EXE or comspec->)
  1172.  * mode = "r" | "w"
  1173.  */
  1174. FILE *
  1175. popen(cmd, mode)
  1176. char *cmd;
  1177. char *mode;
  1178. {
  1179.  
  1180.     int whandle, rhandle;
  1181.     int phandle, chandle, shandle;
  1182.     int rc;
  1183.     char *cmdshell;
  1184.  
  1185.     /* Validate */
  1186.     if(cmd == NULL || mode == NULL) return NULL;
  1187.     if(tolower(*mode) != 'r' && tolower(*mode) != 'w')
  1188.     return NULL;
  1189.  
  1190.     /* Create the pipe */
  1191.     if (DosMakePipe(&rhandle, &whandle, BUFSIZ) < 0)
  1192.     return NULL;
  1193.  
  1194.     /* Dup STDIN or STDOUT to the pipe */
  1195.     if (*mode == 'r') {
  1196.     /* Dup stdout */
  1197.     phandle = rhandle;
  1198.     chandle = whandle;
  1199.     shandle = dup(1);    /* Save STDOUT */
  1200.     rc = dup2(chandle, 1);
  1201.     } else {
  1202.     /* Dup stdin */
  1203.     phandle = whandle;
  1204.     chandle = rhandle;
  1205.     shandle = dup(0);    /* Save STDIN */
  1206.     rc = dup2(chandle, 0);
  1207.     }
  1208.     if (rc < 0) {
  1209.     perror("dup2");
  1210.     return NULL;
  1211.     }
  1212.     close(chandle);
  1213.  
  1214.     /* Make sure that we don't pass this handle on */
  1215.     DosSetFHandState(phandle, OPEN_FLAGS_NOINHERIT);
  1216.  
  1217.     /* Invoke the child, remember its processid */
  1218.     cmdshell = getenv("COMSPEC");
  1219.     if (cmdshell == NULL) cmdshell = "CMD.EXE";
  1220.  
  1221.     _pipes[chandle] = spawnlp(P_NOWAIT, cmdshell, cmdshell,"/c",cmd, NULL);
  1222.  
  1223.     /* Clean up by reestablishing our STDIN/STDOUT */
  1224.     if (*mode == 'r')
  1225.     rc = dup2(shandle, 1);
  1226.     else
  1227.     rc = dup2(shandle, 0);
  1228.     if (rc < 0) {
  1229.     perror("dup2");
  1230.     return NULL;
  1231.     }
  1232.     close(shandle);
  1233.  
  1234.     return fdopen(phandle, mode);
  1235. }
  1236. pclose(ptr)
  1237. FILE *ptr;
  1238. {
  1239.     int status, pnum;
  1240.  
  1241.     pnum = fileno(ptr);
  1242.     fclose(ptr);
  1243.  
  1244.     /* Now wait for child to end */
  1245.     cwait(&status, _pipes[pnum], WAIT_GRANDCHILD);
  1246.  
  1247.     return status;
  1248. }
  1249.  
  1250. /* End of pipe support for OS/2 */
  1251. #endif                    /* OS2 */
  1252.  
  1253. #if UNIX
  1254. #ifdef ATTM32
  1255.  
  1256. /*
  1257.  * This file contains the routine necessary to allocate legal AT&T
  1258.  * 3B2/15/4000 stack space for co-expression stacks.
  1259.  *
  1260.  * Legal stack region begins at 0xC0020000, and UNIX will grow stack space
  1261.  * up to 50 Megabytes. 0xC0030000 should provide plenty of room for
  1262.  * main C stack growth.  Each time coexpr_salloc() is called, it
  1263.  * adds mstksize (max main stack size) and returns a new address,
  1264.  * meaning each coexpression stack is potentially as large as the main stack.
  1265.  */
  1266.  
  1267. /*
  1268.  * coexp_salloc() - return pointer in legal stack space for start
  1269.  *                  of a coexpression stack.
  1270.  */
  1271.  
  1272. pointer coexp_salloc()
  1273.    {
  1274.    static pointer sp = 0xC0030000 ;     /* pointer to stack region */
  1275.  
  1276.    sp +=  mstksize;
  1277.    return sp;
  1278. }
  1279. #endif                    /* ATTM32 */
  1280.  
  1281. #endif                    /* UNIX */
  1282.  
  1283. #if VMS
  1284. #passthru #define LIB_GET_EF    LIB$GET_EF
  1285. #passthru #define SYS_CREMBX    SYS$CREMBX
  1286. #passthru #define LIB_FREE_EF   LIB$FREE_EF
  1287. #passthru #define DVI__DEVNAM   DVI$_DEVNAM
  1288. #passthru #define SYS_GETDVIW   SYS$GETDVIW
  1289. #passthru #define SYS_DASSGN    SYS$DASSGN
  1290. #passthru #define LIB_SPAWN     LIB$SPAWN
  1291. #passthru #define SYS_QIOW      SYS$QIOW
  1292. #passthru #define IO__WRITEOF   IO$_WRITEOF
  1293. #passthru #define SYS_WFLOR     SYS$WFLOR
  1294. #passthru #define sys_expreg    sys$expreg
  1295. #passthru #define STS_M_SUCCESS STS$M_SUCCESS
  1296. #passthru #define sys_cretva    sys$cretva
  1297.  
  1298. typedef struct _descr {
  1299.    int length;
  1300.    char *ptr;
  1301. } descriptor;
  1302.  
  1303. typedef struct _pipe {
  1304.    long pid;            /* process id of child */
  1305.    long status;            /* exit status of child */
  1306.    long flags;            /* LIB$SPAWN flags */
  1307.    int channel;            /* MBX channel number */
  1308.    int efn;            /* Event flag to wait for */
  1309.    char mode;            /* the open mode */
  1310.    FILE *fptr;            /* file pointer (for fun) */
  1311.    unsigned running : 1;    /* 1 if child is running */
  1312. } Pipe;
  1313.  
  1314. Pipe _pipes[_NFILE];        /* one for every open file */
  1315.  
  1316. #define NOWAIT        1
  1317. #define NOCLISYM    2
  1318. #define NOLOGNAM    4
  1319. #define NOKEYPAD    8
  1320. #define NOTIFY        16
  1321. #define NOCONTROL    32
  1322. #define SFLAGS    (NOWAIT|NOKEYPAD|NOCONTROL)
  1323.  
  1324. /*
  1325.  * popen - open a pipe command
  1326.  * Last modified 2-Apr-86/chj
  1327.  *
  1328.  *    popen("command", mode)
  1329.  */
  1330.  
  1331. FILE *popen(cmd, mode)
  1332. char *cmd;
  1333. char *mode;
  1334. {
  1335.    FILE *pfile;            /* the Pfile */
  1336.    Pipe *pd;            /* _pipe database */
  1337.    descriptor mbxname;        /* name of mailbox */
  1338.    descriptor command;        /* command string descriptor */
  1339.    descriptor nl;        /* null device descriptor */
  1340.    char mname[65];        /* mailbox name string */
  1341.    int chan;            /* mailbox channel number */
  1342.    int status;            /* system service status */
  1343.    int efn;
  1344.    struct {
  1345.       short len;
  1346.       short code;
  1347.       char *address;
  1348.       char *retlen;
  1349.       int last;
  1350.    } itmlst;
  1351.  
  1352.    if (!cmd || !mode)
  1353.       return (0);
  1354.    LIB_GET_EF(&efn);
  1355.    if (efn == -1)
  1356.       return (0);
  1357.    if (_tolower(mode[0]) != 'r' && _tolower(mode[0]) != 'w')
  1358.       return (0);
  1359.    /* create and open the mailbox */
  1360.    status = SYS_CREMBX(0, &chan, 0, 0, 0, 0, 0);
  1361.    if (!(status & 1)) {
  1362.       LIB_FREE_EF(&efn);
  1363.       return (0);
  1364.    }
  1365.    itmlst.last = mbxname.length = 0;
  1366.    itmlst.address = mbxname.ptr = mname;
  1367.    itmlst.retlen = &mbxname.length;
  1368.    itmlst.code = DVI__DEVNAM;
  1369.    itmlst.len = 64;
  1370.    status = SYS_GETDVIW(0, chan, 0, &itmlst, 0, 0, 0, 0);
  1371.    if (!(status & 1)) {
  1372.       LIB_FREE_EF(&efn);
  1373.       return (0);
  1374.    }
  1375.    mname[mbxname.length] = '\0';
  1376.    pfile = fopen(mname, mode);
  1377.    if (!pfile) {
  1378.       LIB_FREE_EF(&efn);
  1379.       SYS_DASSGN(chan);
  1380.       return (0);
  1381.    }
  1382.    /* Save file information now */
  1383.    pd = &_pipes[fileno(pfile)];    /* get Pipe pointer */
  1384.    pd->mode = _tolower(mode[0]);
  1385.    pd->fptr = pfile;
  1386.    pd->pid = pd->status = pd->running = 0;
  1387.    pd->flags = SFLAGS;
  1388.    pd->channel = chan;
  1389.    pd->efn = efn;
  1390.    /* fork the command */
  1391.    nl.length = strlen("_NL:");
  1392.    nl.ptr = "_NL:";
  1393.    command.length = strlen(cmd);
  1394.    command.ptr = cmd;
  1395.    status = LIB_SPAWN(&command,
  1396.       (pd->mode == 'r') ? 0 : &mbxname,    /* input file */
  1397.       (pd->mode == 'r') ? &mbxname : 0,    /* output file */
  1398.       &pd->flags, 0, &pd->pid, &pd->status, &pd->efn, 0, 0, 0, 0);
  1399.    if (!(status & 1)) {
  1400.       LIB_FREE_EF(&efn);
  1401.       SYS_DASSGN(chan);
  1402.       return (0);
  1403.    } else {
  1404.       pd->running = 1;
  1405.    }
  1406.    return (pfile);
  1407. }
  1408.  
  1409. /*
  1410.  * pclose - close a pipe
  1411.  * Last modified 2-Apr-86/chj
  1412.  *
  1413.  */
  1414. pclose(pfile)
  1415. FILE *pfile;
  1416. {
  1417.    Pipe *pd;
  1418.    int status;
  1419.    int fstatus;
  1420.  
  1421.    pd = fileno(pfile) ? &_pipes[fileno(pfile)] : 0;
  1422.    if (pd == NULL)
  1423.       return (-1);
  1424.    fflush(pd->fptr);            /* flush buffers */
  1425.    fstatus = fclose(pfile);
  1426.    if (pd->mode == 'w') {
  1427.       status = SYS_QIOW(0, pd->channel, IO__WRITEOF, 0, 0, 0, 0, 0, 0, 0, 0, 0);
  1428.       SYS_WFLOR(pd->efn, 1 << (pd->efn % 32));
  1429.    }
  1430.    SYS_DASSGN(pd->channel);
  1431.    LIB_FREE_EF(&pd->efn);
  1432.    pd->running = 0;
  1433.    return (fstatus);
  1434. }
  1435.  
  1436. /*
  1437.  * redirect(&argc,argv,nfargs) - redirect standard I/O
  1438.  *    int *argc        number of command arguments (from call to main)
  1439.  *    char *argv[]    command argument list (from call to main)
  1440.  *    int nfargs    number of filename arguments to process
  1441.  *
  1442.  * argc and argv will be adjusted by redirect.
  1443.  *
  1444.  * redirect processes a program's command argument list and handles redirection
  1445.  * of stdin, and stdout.  Any arguments which redirect I/O are removed from the
  1446.  * argument list, and argc is adjusted accordingly.  redirect would typically be
  1447.  * called as the first statement in the main program.
  1448.  *
  1449.  * Files are redirected based on syntax or position of command arguments.
  1450.  * Arguments of the following forms always redirect a file:
  1451.  *
  1452.  *    <file    redirects standard input to read the given file
  1453.  *    >file    redirects standard output to write to the given file
  1454.  *    >>file    redirects standard output to append to the given file
  1455.  *
  1456.  * It is often useful to allow alternate input and output files as the
  1457.  * first two command arguments without requiring the <file and >file
  1458.  * syntax.  If the nfargs argument to redirect is 2 or more then the
  1459.  * first two command arguments, if supplied, will be interpreted in this
  1460.  * manner:  the first argument replaces stdin and the second stdout.
  1461.  * A filename of "-" may be specified to occupy a position without
  1462.  * performing any redirection.
  1463.  *
  1464.  * If nfargs is 1, only the first argument will be considered and will
  1465.  * replace standard input if given.  Any arguments processed by setting
  1466.  * nfargs > 0 will be removed from the argument list, and again argc will
  1467.  * be adjusted.  Positional redirection follows syntax-specified
  1468.  * redirection and therefore overrides it.
  1469.  *
  1470.  */
  1471.  
  1472.  
  1473. redirect(argc,argv,nfargs)
  1474. int *argc, nfargs;
  1475. char *argv[];
  1476. {
  1477.    int i;
  1478.  
  1479.    i = 1;
  1480.    while (i < *argc)  {        /* for every command argument... */
  1481.       switch (argv[i][0])  {        /* check first character */
  1482.          case '<':            /* <file redirects stdin */
  1483.             filearg(argc,argv,i,1,stdin,"r");
  1484.             break;
  1485.          case '>':            /* >file or >>file redirects stdout */
  1486.             if (argv[i][1] == '>')
  1487.                filearg(argc,argv,i,2,stdout,"a");
  1488.             else
  1489.                filearg(argc,argv,i,1,stdout,"w");
  1490.             break;
  1491.          default:            /* not recognized, go on to next arg */
  1492.             i++;
  1493.       }
  1494.    }
  1495.    if (nfargs >= 1 && *argc > 1)    /* if positional redirection & 1 arg */
  1496.       filearg(argc,argv,1,0,stdin,"r");    /* then redirect stdin */
  1497.    if (nfargs >= 2 && *argc > 1)    /* likewise for 2nd arg if wanted */
  1498.       filearg(argc,argv,1,0,stdout,"w");/* redirect stdout */
  1499. }
  1500.  
  1501.  
  1502.  
  1503. /* filearg(&argc,argv,n,i,fp,mode) - redirect and remove file argument
  1504.  *    int *argc        number of command arguments (from call to main)
  1505.  *    char *argv[]    command argument list (from call to main)
  1506.  *    int n        argv entry to use as file name and then delete
  1507.  *    int i        first character of file name to use (skip '<' etc.)
  1508.  *    FILE *fp        file pointer for file to reopen (typically stdin etc.)
  1509.  *    char mode[]    file access mode (see freopen spec)
  1510.  */
  1511.  
  1512. filearg(argc,argv,n,i,fp,mode)
  1513. int *argc, n, i;
  1514. char *argv[], mode[];
  1515. FILE *fp;
  1516. {
  1517.    if (strcmp(argv[n]+i,"-"))        /* alter file if arg not "-" */
  1518.       fp = freopen(argv[n]+i,mode,fp);
  1519.    if (fp == NULL)  {            /* abort on error */
  1520.       fprintf(stderr,"%%can't open %s",argv[n]+i);
  1521.       exit(ErrorExit);
  1522.    }
  1523.    for ( ;  n < *argc;  n++)        /* move down following arguments */
  1524.       argv[n] = argv[n+1];
  1525.    *argc = *argc - 1;            /* decrement argument count */
  1526. }
  1527.  
  1528. /* Special versions of sbrk() and brk() for use by Icon under VMS.
  1529.  * #defines in define.h actually rename these to vms_brk and vms_sbrk.
  1530.  *
  1531.  * For historical reasons, Icon assumes it can repeatedly call brk/sbrk
  1532.  * and always get contiguous chunks.  This was made to work under Unix by
  1533.  * overloading the definitions of malloc and friends, the only other callers
  1534.  * of sbrk, and making them return Icon-managed memory.
  1535.  
  1536.  * Under VMS, sbrk is not the lowest-level system interface.  It gets memory
  1537.  * from underlying VMS routines such as SYS$EXPREG.  These routines are also
  1538.  * called by others, for example when a file is opened;  so successive sbrk
  1539.  * calls may return nonadjacent chunks.  This makes overloading malloc and
  1540.  * friends futile.
  1541.  *
  1542.  * The routines below replace sbrk and brk for Icon (only) under VMS.  They
  1543.  * provide the continuously growing memory Icon needs without relying on
  1544.  * special privileges or unusually large quotas.  Like the Unix solution and
  1545.  * earlier VMS attempts, this is an empirical solution and may need further
  1546.  * revision as the system changes.  But we hope not.
  1547.  *
  1548.  * The Icon interpreter is loaded beginning at address 0 and grows upward as
  1549.  * it requests more memory through sbrk.  The C stack grows downward from
  1550.  * 0x7FFFFFFF. We're going to draw a line to divide the address space, then
  1551.  * force the C and VMS runtime systems to put anything they need above it;
  1552.  * then sbrk can grow the program region unimpeded up to the line.
  1553.  *
  1554.  * The line is drawn MAXMEM bytes beyond the start of the sbrk region.  MAXMEM
  1555.  * is an environment variable (logical name to VMS) with a default as given in
  1556.  * define.h.  Large values cost CPU and real time expended at process exit; we
  1557.  * don't know why.  On an 8600 the cost was very roughly .04 CP sec / megabyte.
  1558.  *
  1559.  * When first called, sbrk expands the program region by one page to get a
  1560.  * starting address.  A limit address is calculated by adding MAXMEM.  A single
  1561.  * page created just below the limit address "draws the line" and causes the
  1562.  * VMS runtime system to allocate anything it needs above that point.  sbrk
  1563.  * creates pages between base and limit as needed.
  1564.  *
  1565.  * Possible errors and their manifestations:
  1566.  *
  1567.  *    MAXMEM too large to initialize sbrk:
  1568.  *       error in startup code: value of MAXMEM too large
  1569.  *
  1570.  *    MAXMEM too small to initialize sbrk:
  1571.  *       error in startup code: value of MAXMEM too small
  1572.  *
  1573.  *    MAXMEM too small for subsequent brk/sbrk growth
  1574.  *       Run-time error 351:  insufficient MAXMEM limit
  1575.  *
  1576.  *    MAXMEM okay but insufficient user quota for needed memory:
  1577.  *       Run-time error 303:  unable to expand memory region
  1578.  *
  1579.  *    unexpected ("can't happen") failures of system calls:
  1580.  *       these produce their standard VMS error message
  1581.  *
  1582.  *    unexpected intrusion into the sbrk region by the runtime system:
  1583.  *       unknown, but undoubtedly ugly
  1584.  */
  1585.  
  1586.  
  1587. #define PageSize 512        /* size of a VMS page */
  1588. #define MaxP0 0x40000000    /* first address beyond the P0 region */
  1589.  
  1590. word memsize = MaxMem;        /* set from environment variable MAXMEM */
  1591.  
  1592.  
  1593. /*  sbrk(incr) - adjust the break value by incr, rounding up to a page.
  1594.  *  returns the new break value, or -1 if unsuccessful.
  1595.  */
  1596.  
  1597. char *
  1598. sbrk(incr)
  1599. int incr;
  1600. {
  1601.    static char *base;        /* base of the sbrk region */
  1602.    static char *curr;        /* current break value (end+1) */
  1603.    static char *limit;        /* region limit ("the line") */
  1604.    char *range[2], *p;        /* scratch for system calls */
  1605.    int s;            /* status return from calls */
  1606.  
  1607.    /*  initialization code */
  1608.    if (!base)  {
  1609.       s = sys_expreg(1,range,0,0);    /* expand P0 to get base address */
  1610.       if (!(s & STS_M_SUCCESS))
  1611.          exit(s);            /* couldn't get one page?! */
  1612.       base = curr = range[0];        /* initialize empty sbrk region */
  1613.       memsize = (memsize + PageSize - 1) & -PageSize;
  1614.                     /* round memsize to page boundary */
  1615.       limit = base + memsize;        /* calculate sbrk region limit*/
  1616.       if (limit > MaxP0)
  1617.      limit = MaxP0;            /* limit to legal values */
  1618.       if (limit <= base)
  1619.          error("value of MAXMEM too small");  /* can't even start */
  1620.       range[0] = range[1] = limit-1;
  1621.       s = sys_cretva(range,range,0);    /* get a page there to draw the line */
  1622.       if (!(s & STS_M_SUCCESS))
  1623.          error("value of MAXMEM too large");  /* can't even start */
  1624.    }
  1625.  
  1626.    if (incr > 0)  {
  1627.  
  1628.       /* grow the region */
  1629.       if (curr + incr > limit)        /* check address space available */
  1630.          fatalerr(351,NULL);        /* oops, MAXMEM too small */
  1631.       range[0] = curr;
  1632.       range[1] = curr + incr - 1;
  1633.       s = sys_cretva(range,range,0);    /* ask for the pages */
  1634.       if (!(s & STS_M_SUCCESS))
  1635.          return (char *) -1;        /* failed, quota exceeded */
  1636.       curr = range[1] + 1;        /* set new break value as returned */
  1637.  
  1638.    } else if (incr < 0) {
  1639.  
  1640.       /* shrink the region (not expected to be used).  does not actually
  1641.        * return the memory, but does make it available for reuse.  */
  1642.       curr -= -incr & -PageSize;
  1643.    }
  1644.  
  1645.    /* return the current break value */
  1646.    return curr;
  1647. }
  1648.  
  1649.  
  1650.  
  1651.  
  1652. /*  brk(addr) - set the break address to the given value, rounded up to a page.
  1653.  *  returns 0 if successful, -1 if not.
  1654.  */
  1655.  
  1656. char *
  1657. brk(addr)
  1658. char *addr;
  1659. {
  1660.    return ((sbrk(addr-sbrk(0))) == (char *) -1 ? (char *) -1 : 0);
  1661. }
  1662. #endif                    /* VMS */
  1663.  
  1664. /*
  1665.  * End of operating-system specific code.
  1666.  */
  1667.  
  1668. static char x;            /* avoid empty module */
  1669.